home *** CD-ROM | disk | FTP | other *** search
/ TeX 1995 July / TeX CD-ROM July 1995 (Disc 1)(Walnut Creek)(1995).ISO / macros / latex209 / contrib / slatex / config.ss < prev    next >
Text File  |  1993-11-07  |  6KB  |  213 lines
  1. ;config.ss
  2. ;Configures SLaTeX for your system
  3. ;(c) Dorai Sitaram, December 1991, Rice University
  4.  
  5. ;IMPORTANT: You need to change only the lines defining the variables
  6. ;  *dialect*   and   *op-sys*
  7.  
  8. ;After making the changes, this file can be loaded in any RnRS
  9. ;Scheme, or Common Lisp.
  10. ;Enter Scheme (or Lisp), and type (load "config.ss").  This creates
  11. ;slatex.ss in the current directory.
  12.  
  13. (if (not 'nil)
  14.     ;this is a kludge to test if you're in Scheme or in CL.
  15.     ;if the latter, load CL procedures that emulate Scheme
  16.     ;so the remaining stuff can be recognized by CL
  17.     (load "funval.cl")
  18.     'ok)
  19. (if (not 'nil)
  20.     ;continues the good work begun by the previous sexp
  21.     (load "rnrscl.cl")
  22.     'ok)
  23.  
  24. (define *dialect* 'scmj)
  25. (define *op-sys* 'dos)
  26.  
  27. (load "preproc.ss")
  28.  
  29. (if (not 'nil) (set! *dialect* 'cl))
  30.  
  31. (define eoln
  32.   (cond ((eq? *op-sys* 'unix) (string #\newline))
  33.       ((eq? *op-sys* 'dos) (string #\return #\newline))
  34.       (else (string #\newline))))
  35.  
  36. (define display*
  37.   (lambda (p . z)
  38.     (if p (for-each (lambda (x) (display x p)) z)
  39.         (for-each display z))))
  40.  
  41. (define reader-request
  42.   (lambda (request choices action default)
  43.     (request)
  44.     (let loop ()
  45.       (let ((user-input (read)))
  46.     (if (memq user-input choices)
  47.         (action user-input)
  48.         (if default
  49.         (begin
  50.           (display* #f user-input " not supported -- choosing "
  51.             default "." eoln)
  52.           (action default))
  53.         (begin
  54.           (display* #f "Please type one of " choices "." eoln)
  55.           (loop))))))))
  56.  
  57. (reader-request
  58.   (lambda ()
  59.     (display* #f eoln "Dialect specified as " *dialect* " -- approved?  "
  60.       "Answer y(es) or n(o)." eoln))
  61.   '(y yes n no)
  62.   (lambda (user-input)
  63.     (if (memq user-input '(y yes)) 'ok
  64.       (reader-request
  65.     (lambda ()
  66.       (display* #f eoln "Type name of dialect -- should be one of" eoln
  67.         "  chez cl cscheme elk schemetoc scmj umbscheme other." eoln
  68.         "  (For details, please see install.doc.)" eoln))
  69.     '(chez cl cscheme elk schemetoc scmj umbscheme other)
  70.     (lambda (user-input)
  71.       (set! *dialect* user-input))
  72.     'other)))
  73.   #f)
  74.  
  75. (reader-request
  76.   (lambda ()
  77.     (display* #f eoln "Operating system specified as " *op-sys*
  78.       " -- approved?  Answer y(es) or n(o)." eoln))
  79.   '(y yes n no)
  80.   (lambda (user-input)
  81.     (if (memq user-input '(y yes)) 'ok
  82.       (reader-request
  83.     (lambda ()
  84.       (display* #f eoln "Type name of system -- should be one of" eoln
  85.         "  unix dos." eoln))
  86.     '(unix dos)
  87.     (lambda (user-input)
  88.       (set! *op-sys* user-input))
  89.     'unix)))
  90.   #f)
  91.  
  92. (display* #f eoln "Beginning configuring SLaTeX -- wait..." eoln)
  93.  
  94. (define transmit
  95.   (lambda (x out)
  96.     (write (preprocess-macros x) out)))
  97.  
  98. (define select
  99.   (lambda (in out)
  100.     (let loop ()
  101.       (let ((x (read in)))
  102.     (cond ((eof-object? x) 'done)
  103.           ((and (pair? x) (eq? (car x) 'quote)
  104.             (pair? (cdr x)) (null? (cddr x))
  105.             (pair? (cadr x))
  106.             (memq (caadr x) '(enable disable)))
  107.            (let* ((dialects (cdadr x)) 
  108.               (y (read in))
  109.               (shd-extract?
  110.               (let ((isin? (memq *dialect* dialects)))
  111.                 (if (eq? (caadr x) 'enable)
  112.                 isin?
  113.                 (not isin?)))))
  114.            (if shd-extract?
  115.                (begin (transmit y out) (newline out))
  116.                'do-not-extract)
  117.            (loop)))
  118.             (else (transmit x out) (newline out) (loop)))))))
  119.  
  120. (define port-copy
  121.   (lambda (in out)
  122.     (let loop ()
  123.       (let ((x (read in)))
  124.     (if (eof-object? x) 'done
  125.       (begin (write x out) (newline out) (loop)))))))
  126.  
  127. (define generate-compatible-file
  128.   (lambda (output-file)
  129.  
  130.     (cond ((memq *dialect* '(chez cscheme scmj))
  131.        (if (file-exists? output-file)
  132.            (delete-file output-file) 'ok))
  133.       ((eq? *dialect* 'cl)
  134.        (if (probe-file output-file)
  135.            (delete-file output-file) 'ok))
  136.       (else
  137.         (display* #f eoln
  138.           "If configuring fails following this sentence," eoln
  139.           "you most likely already have a slatex.ss in the current "
  140.           "directory." eoln
  141.           "Delete it and retry." eoln)))
  142.           
  143.     (call-with-output-file output-file
  144.       (lambda (out)
  145.       
  146.     ;begin banner
  147.     (display* out 
  148.       ";slatex.ss file generated using config.ss" eoln
  149.       ";This file is compatible for the dialect " *dialect* eoln
  150.       ";(c) dorai@rice.edu Dec. 1991" eoln eoln)
  151.     ;end banner
  152.  
  153.     (if (eq? *dialect* 'cl)
  154.         (begin
  155.           (call-with-input-file "funval.cl"
  156.         (lambda (in)
  157.           (port-copy in out)))
  158.           (call-with-input-file "rnrscl.cl"
  159.         (lambda (in)
  160.           (port-copy in out))))
  161.         'using-scheme)
  162.  
  163.     (display* out "(define *op-sys* '"
  164.       (cond ((eq? *op-sys* 'unix) 'unix)
  165.           ((eq? *op-sys* 'dos) 'dos)
  166.           (else 'unix)) ;assume it's unix-like
  167.       ")" eoln)
  168.  
  169.     (for-each
  170.       (lambda (file)
  171.         (call-with-input-file file
  172.           (lambda (in)
  173.         (select in out))))
  174.       (list
  175.         "optchez.ss"
  176.         "seqprocs.ss"
  177.         "fileproc.ss"
  178.         "lerror.ss"
  179.         "helpers.ss"
  180.         "defaults.ss"
  181.         "structs.ss"
  182.         "peephole.ss"
  183.         "codeset.ss"
  184.         "pathproc.ss"
  185.         "texread.ss"
  186.         "proctex.ss"
  187.         "proctex2.ss"))
  188.  
  189.     ))))
  190.  
  191. (generate-compatible-file 
  192.   (if (eq? *dialect* 'chez) "temp.ss" "slatex.ss"))
  193.  
  194. (if (eq? *dialect* 'chez)
  195.     (begin 
  196.       (display* #f eoln
  197.     "Getting compiled version for Chez Scheme..." eoln)
  198.       (compile-file "temp.ss" "slatex.ss")
  199.       (delete-file "temp.ss")
  200.       (display* #f "Finished compilation." eoln))
  201.     'ok)
  202.  
  203. (display* #f eoln
  204.   "Finished configuring SLaTeX for your machine." eoln
  205.   "Read install.doc for details on" eoln
  206.   "  a) which paths to place the SLaTeX files in;" eoln
  207.   "  b) how to modify the given batch file or shell script "
  208.   "that invokes SLaTeX." eoln)
  209.  
  210. (cond ((memq *dialect* '(chez scmj)) (exit))
  211.       ((eq? *dialect* 'cscheme) (%exit))  
  212.       (else (display* #f "You may exit Scheme now!" eoln)))
  213.